Quick PC 61/Quick PC 61.iso/I386/WMS.CAB/wmscommon.inc

Text File | 2003-02-21 | 21.8 KB | 725 lines

<%
'+-------------------------------------------------------------------------
'
'  Microsoft Windows Media
'  Copyright (C) Microsoft Corporation. All rights reserved.
'
'  File:       common.inc
'
'  Contents:    Included by nearly all WMS Admin .asp files
'
'--------------------------------------------------------------------------

if( 0 = Len( CStr( Session( "BaseHREF" ) ) ) ) then
    Session( "BaseHREF" ) = Request.ServerVariables( "HTTP_HOST" )
end if

on error resume next
Set s_WMSAdmin = Session( "WMSAdmin" )
if( ( null = s_WMAdmin ) or IsEmpty( s_WMSAdmin ) ) then
    Set s_WMSAdmin = Server.CreateObject("WMSAdminRemote.ASPAdmin")
    Set Session("WMSAdmin") = s_WMSAdmin
end if

'///////////////////////////
Sub BrowserSniff()
    if( 0 = Len( Session( "BrowserVersion" ) ) ) then

        Dim strBrowser
        Dim objBrowseCap

        err.Clear

        g_dwBrowserType = brUnknown
        g_curBrowserVersion = 0
        g_strUserAgent = Request.ServerVariables( "HTTP_USER_AGENT" )

        Set objBrowseCap = Server.CreateObject( "MSWC.BrowserType" )
        if( 0 = err.number ) then
            strBrowser = objBrowseCap.browser
            if( 0 = StrComp( "IE", strBrowser, vbTextCompare ) ) then
                g_dwBrowserType = brMSIE
            elseif( 0 = StrComp( "Netscape", strBrowser, vbTextCompare ) ) then
                g_dwBrowserType = brNetscape
            elseif( 0 = StrComp( "Opera", strBrowser, vbTextCompare ) ) then
                g_dwBrowserType = brOpera
            end if

            g_curBrowserVersion = CCur( objBrowseCap.version )
        end if

        if( brUnknown = g_dwBrowserType ) then
            if( 0 < InStr( 1, g_strUserAgent, "MSIE", vbTextCompare ) ) then
                g_dwBrowserType = brMSIE
                g_curBrowserVersion = CCur( Mid( g_strUserAgent, InStr( 1, g_strUserAgent, "MSIE", vbTextCompare ) + 5, 3 ) )
                if( 0 >= g_curBrowserVersion ) then
                    g_curBrowserVersion = CCur( Mid( g_strUserAgent, InStr( 1, g_strUserAgent, "MSIE", vbTextCompare ) + 5, 1 ) )
                end if
            elseif( 0 < InStr( 1, g_strUserAgent, "Opera", vbTextCompare ) ) then
                g_dwBrowserType = brOpera
                g_curBrowserVersion = CCur( Mid( g_strUserAgent, InStr( 1, g_strUserAgent, "Opera", vbTextCompare ) + 6, 1 ) )
            else
                g_dwBrowserType = brNetscape
                if( 0 < InStr( 1, g_strUserAgent, "Gecko", vbTextCompare ) ) then
                    g_curBrowserVersion = CCur( Mid( g_strUserAgent, 9, 1 ) )
                else
                    g_curBrowserVersion = CCur( Mid( g_strUserAgent, InStrRev( g_strUserAgent, "/", -1, vbTextCompare ) + 1, 1 ) )
                    if( 0 = g_curBrowserVersion ) then
                        g_curBrowserVersion = CCur( Mid( g_strUserAgent, InStr( g_strUserAgent, "/", -1, vbTextCompare ) + 1, 1 ) )
                        if( 2 >= g_curBrowserVersion ) then
                            if( 0 < InStr( 1, g_strUserAgent, "Gecko", vbTextCompare ) ) then
                                g_curBrowserVersion = CCur( "5.0" )
                            end if
                        end if
                    end if
                end if
            end if
        end if

        Session( "UserAgent" ) = g_strUserAgent
        Session( "BrowserType" ) = g_dwBrowserType
        Session( "BrowserVersion" ) = g_curBrowserVersion
    else
        g_strUserAgent = Session( "UserAgent" )
        g_dwBrowserType = Session( "BrowserType" )
        g_curBrowserVersion = Session( "BrowserVersion" )
    end if

    ' Set depricated flags
    if( brMSIE = g_dwBrowserType ) then
        g_bMSIE = TRUE
        g_bNetscape = FALSE
        g_bOpera = FALSE
    elseif( brNetscape = g_dwBrowserType ) then
        g_bMSIE = FALSE
        g_bNetscape = TRUE
        g_bOpera = FALSE
    elseif( brOpera = g_dwBrowserType ) then
        g_bMSIE = FALSE
        g_bNetscape = FALSE
        g_bOpera = TRUE
    end if
End Sub


'///////////////////////////
Sub PickStyleSheet()
    BrowserSniff

    g_dwBrowserType = Session( "BrowserType" )
    if( 0 = Len( Session( "cssName" ) ) ) then
        if( brMSIE = g_dwBrowserType ) then
            if( MIN_MSIE_VERSION <= g_curBrowserVersion ) then
                if( 0 >= InStr( g_strUserAgent, "Windows" ) ) then
                    Session( "cssName" ) = "css/wms_macie_admin.css"
                else
                    Session( "cssName" ) = "css/wmsadmin.css"
                end if
            end if
        elseif( brNetscape = g_dwBrowserType ) then
            if( MIN_NSCP_VERSION <= g_curBrowserVersion ) then
                Session( "cssName" ) = "css/wms_ns6_admin.css"
            end if
        elseif( brOpera = g_dwBrowserType ) then
            if( MIN_OPERA_VERSION <= CCur( g_curBrowserVersion ) ) then
                Session( "cssName" ) = "css/wms_ns6_admin.css"
            end if
        else
            Session( "cssName" ) = "css/wmsadmin.css"
        end if
    end if
End Sub


'///////////////////////////
Sub RedirectIfLegacyBrowser()
    Dim bDepricatedBrowser
    Dim curMinSupportedVersion
    bDepricatedBrowser = FALSE

    BrowserSniff

    g_curBrowserVersion = Session( "BrowserVersion" )
    g_dwBrowserType = Session( "BrowserType" )
    if( brMSIE = g_dwBrowserType ) then
        curMinSupportedVersion = CCur( MIN_MSIE_VERSION )
    elseif( brNetscape = g_dwBrowserType ) then
        curMinSupportedVersion = CCur( MIN_NSCP_VERSION )
    elseif( brOpera = g_dwBrowserType ) then
        curMinSupportedVersion = CCur( MIN_OPERA_VERSION )
    else
        curMinSupportedVersion = "255"
        bDepricatedBrowser = TRUE
    end if

    if( FALSE = bDepricatedBrowser ) then
        bDepricatedBrowser = CBool( curMinSupportedVersion > CCur( g_curBrowserVersion ) )
    end if

    if( TRUE = bDepricatedBrowser ) then
        Response.Redirect( "/oldBrowser.asp" )
        Response.Flush
        Response.End
    end if
End Sub

'///////////////////////////
Sub DisableContextMenu()
    if( brMSIE = g_dwBrowserType ) then
        Response.Write( "document.oncontextmenu=" & chr( 34 ) & "return true;event.cancelBubble=true;return false;" & chr(34) & "; " )
    else
        Response.Write( "document.onmouseup=" & chr( 34 ) & chr( 34) & "; " )
    end if
End Sub

'///////////////////////////
'
'  Determines if the the localhost is running the WMS service and
'   builds the local IP address and the local server name.  Sets
'   the following globals:
'
'       g_strLocalHostName, g_strLocalHostDNSName, g_strLocalHostIP, g_bLocalHostRunningWMS
'
'  We then cache these values into application state, since they're not
'   likely to change throughout the course of execution
'
Sub SyncWithApplicationState()

    if( 0 = Len( Application( "strLocalHostName" ) ) ) then
        Dim strServerName
        Dim strServerDNSName
        Dim strServerIP
        Dim strDomainName
        Dim dwConnectionFailureCode

        strServerName = s_WMSAdmin.GetCanonicalComputerName( "localhost", WMS_ComputerNameNetBIOS )
        strServerDNSName = s_WMSAdmin.GetCanonicalComputerName( "localhost", WMS_ComputerNameDnsFullyQualified )
        strDomainName = s_WMSAdmin.GetCanonicalComputerName( "localhost", WMS_ComputerNameDnsDomain )

        if( 0 = Len( strServerName ) )then
            strServerName = strServerDNSName
            if( 0 = Len( strServerName ) ) then
                strServerName = "localhost"
            end if
        end if

        if( 0 = StrComp( "127.0.0.1", strServerName, vbTextCompare ) ) then
            strServerName = "localhost"
            strServerIP = "127.0.0.1"
        else
            strServerIP = s_WMSAdmin.ResolveToIP( strServerName )
        end if

        dwConnectionFailureCode = s_WMSAdmin.GetServiceStatus( strServerName )
        if( WMS_SERVICE_STOPPED = dwConnectionFailureCode ) or _
        ( WMS_SERVICE_STARTED = dwConnectionFailureCode ) or _
        ( WMS_SERVICE_INERROR = dwConnectionFailureCode ) or _
        ( WMS_SERVICE_FAILEDTOSTART = dwConnectionFailureCode ) then
            g_bLocalHostRunningWMS = TRUE   ' is the service installed on the box, regardless of whether or not it works
        else
            g_bLocalHostRunningWMS = FALSE
        end if

        g_strLocalHostName = strServerName
        g_strLocalHostDNSName = strServerDNSName
        g_strLocalHostIP = strServerIP
        g_strDomainName = strDomainName

        ' Cache these values into application state

        Application.Lock
        Application( "strLocalHostName" ) = g_strLocalHostName
        Application( "strLocalHostDNSName" ) = g_strLocalHostDNSName
        Application( "strDomainName" ) = g_strDomainName
        Application( "strHostIPAddress" ) = g_strLocalHostIP
        Application( "bLocalHostHasWMS" ) = g_bLocalHostRunningWMS
        Application.Unlock

    end if
    if( 0 = Len( Session( "strLocalHostName" ) ) ) then

        ' Cache these values into session state

        Application.Lock
        Session( "strLocalHostName" ) = Application( "strLocalHostName" )
        Session( "strLocalHostDNSName" ) = Application( "strLocalHostDNSName" )
        Session( "strDomainName" ) = Application( "strDomainName" )
        Session( "strHostIPAddress" ) = Application( "strHostIPAddress" )
        Session( "bLocalHostHasWMS" ) = Application( "bLocalHostHasWMS" )
        Application.Unlock

    end if

    g_strLocalHostName = Session( "strLocalHostName" )
    g_strLocalHostDNSName = Session( "strLocalHostDNSName" )
    g_strDomainName = Session( "strDomainName" )
    g_strLocalHostIP = Session( "strHostIPAddress" )
    g_bLocalHostRunningWMS = Session( "bLocalHostHasWMS" )

End Sub

'///////////////////////////
Function BoolToText( bValue )
    if( bValue ) then
        BoolToText = "true"
    else
        BoolToText = "false"
    end if
End Function


'///////////////////////////
' RemoveSpecifiedChars
' -------------
' eliminates bad characters specified in second argument.
' See http://support.microsoft.com/support/kb/articles/Q252/9/85.ASP
Function RemoveSpecifiedChars( strInput, strPattern )
    Dim RegEx
    Set regEx = New RegExp
    regEx.Pattern = strPattern
    regEx.IgnoreCase = TRUE
    regEx.Global = TRUE
    regEx.Multiline = TRUE
    RemoveSpecifiedChars = regEx.Replace( strInput, "" )
End Function

'///////////////////////////
' ContainsSpecifiedChars
' -------------
' detects specified characters specified in second argument.
' See http://support.microsoft.com/support/kb/articles/Q252/9/85.ASP
Function DetectSpecifiedChars( strInput, strPattern )
    Dim RegEx
    Set regEx = New RegExp
    regEx.Pattern = strPattern
    regEx.IgnoreCase = TRUE
    regEx.Global = TRUE
    regEx.Multiline = TRUE
    DetectSpecifiedChars = regEx.Test( strInput )
End Function

'///////////////////////////
' RemoveDangerousCharacters
' -------------
' eliminates bad characters.  See http://support.microsoft.com/support/kb/articles/Q252/9/85.ASP
Function RemoveDangerousCharacters( strInput )
    Dim regEx
    Set regEx = New RegExp
    regEx.Pattern = REGEXP_DANGEROUS_CHARS
    regEx.IgnoreCase = TRUE
    regEx.Global = TRUE
    regEx.Multiline = TRUE
    strInput = Replace( strInput, chr(34), "" ) ' quotes are never allowed
    RemoveDangerousCharacters = regEx.Replace( strInput, "" )
End Function


'///////////////////////////
' SpacesToNonbreak
' -------------
' replaces spaces with nbsp characters

Function SpacesToNonbreak( strInput )
    Dim regEx
    Set regEx = New RegExp
    regEx.Pattern = "\s"
'    regEx.Pattern = " "
    regEx.IgnoreCase = TRUE
    regEx.Global = TRUE
    regEx.Multiline = TRUE
    SpacesToNonbreak = regEx.Replace( strInput, " " )
End Function


'///////////////////////////
' EscBackslashChar
' -------------
' make many strings safe for client-side script

Function EscBackslashChar( strInput )
    Dim regEx
    Set regEx = New RegExp
    regEx.Pattern = "\x005C"
    regEx.IgnoreCase = TRUE
    regEx.Global = TRUE
    regEx.Multiline = TRUE
    EscBackslashChar = regEx.Replace( strInput, "\\" )
End Function

'///////////////////////////
' DashesToNonbreak
' -------------
' replaces dashes with non-break escaped characters

Function DashesToNonbreak( strInput )
    Dim regEx
    Set regEx = New RegExp
    regEx.Pattern = "\x002D|\x00AD"
'    regEx.Pattern = " "
    regEx.IgnoreCase = TRUE
    regEx.Global = TRUE
    regEx.Multiline = TRUE
    DashesToNonbreak = regEx.Replace( strInput, "−" )
End Function


'///////////////////////////
' TrimFileColon
' -------------
' For file paths, we don't wish to display the "file://" prefix.  So,
'  we trim it from the string using this function.

Function TrimFileColon( url )
    Dim dwOffset

    if( 0 = StrComp( Left( url, Len( L_FILECOLON_TEXT ) ), L_FILECOLON_TEXT, vbTextCompare ) ) then
        dwOffset = Len( L_FILECOLON_TEXT ) + 1
        TrimFileColon = Mid( url, dwOffset, Len( url ) - dwOffset + 1 )
    else
        TrimFileColon = url
    end if
End Function



'///////////////////////////
' URLDecode
' -------------
' attempts to undo a javascript escape() call or a Server.HTMLEncode or a Server.URLEncode

Function URLDecode( url )
    temp = url
    x = InStr( temp, "%")
    Do While x > 0
        URLDecode = URLDecode & Left( temp, x-1 )
        URLDecode = URLDecode & Chr( CLng( "&H" & Mid( temp, x+1, 2 ) ) )
        temp = Mid( temp, x+3 )
        x = InStr( temp, "%" )
    Loop
    URLDecode = URLDecode + temp
End Function


'///////////////////////////
' PPNameToIndex
' -------------
' returns the index of the requested pub point, specified by publishing point "name"

Function PPNameToIndex( byRef WMS, byRef strPPName )
    Dim i
    Dim iNumVRoots
    Dim bFound
    Dim strUnescapedName

    strUnescapedName = SafeUnescape( strPPName )

    bFound = FALSE
    iNumVRoots = WMS.PublishingPoints.Count

    PPNameToIndex = -1
    if ( 0 = StrComp( strUnescapedName, L_DEFAULTPPNAME_TEXT, vbTextCompare ) ) then
        strUnescapedName = "/"
        strPPName = "/"
    elseif( 0 = StrComp( strUnescapedName, L_DEFAULTOD_TEXT, vbTextCompare ) ) then
        strUnescapedName = "/"
    elseif( 0 = StrComp( strUnescapedName, L_DEFAULTBC_TEXT, vbTextCompare ) ) then
        strUnescapedName = "/"
    end if

    for i = 0 to iNumVRoots - 1
        if( 0 = StrComp( strUnescapedName, WMS.PublishingPoints.Item(i).Name, vbTextCompare ) ) then
            PPNameToIndex = i
            bFound = TRUE
            Exit For
        end if
    next

    ' Unlikely, but the name of the pub point could have been mangled by the encoding, so try the raw form
    if not bFound then
        for i = 0 to iNumVRoots - 1
            if( 0 = StrComp( strPPName, WMS.PublishingPoints.Item(i).Name, vbTextCompare ) ) then
                PPNameToIndex = i
                bFound = TRUE
                Exit For
            end if
        next
    end if

End Function


'///////////////////////////
' PPIDToIndex
' -------------
' returns the index of the requested pub point, specified by publishing point "ID" -- its GUID

Function PPIDToIndex( byRef pServer, byRef strPPID )
    Dim i
    Dim iNumVRoots

    iNumVRoots = pServer.PublishingPoints.Count

    PPIDToIndex = -1
    for i = 0 to iNumVRoots - 1
        if( 0 = StrComp( strPPID, pServer.PublishingPoints.Item(i).ID, vbTextCompare ) ) then
            PPIDToIndex = i
            Exit Function
        end if
    next

End Function


'///////////////////////////
' ConvertPPName
' -------------
' Converts the name of the default pub point, if detected, away from Slash into something more friendly

Function ConvertPPName( strPPName, dwType )
    if ( 0 = StrComp( "/", strPPName, vbTextCompare ) ) then
        ConvertPPName = L_DEFAULTPPNAME_TEXT

    else
        ConvertPPName = strPPName
    end if
End Function


'///////////////////////////
' ConvertPPName
' -------------
' Converts the friendly name of the default pub point, if detected, back to Slash

Function UnconvertPPName( strPPName )
    if ( 0 = StrComp( L_DEFAULTPPNAME_TEXT, strPPName, vbTextCompare ) ) then
        UnconvertPPName = "/"
    else
        UnconvertPPName = strPPName
    end if
End Function

'///////////////////////////
' jsTRY
' -------------
' Simple macro to generate client-side JScript exception handling -- the Try part

Sub jsTRY()
%>
/*@if (@_jscript_version >= 1.3)
    try
    {
@end @*/
<%
End Sub

'///////////////////////////
' jsCATCH
' -------------
' Simple macro to generate client-side JScript exception handling -- the Catch part
'  Change the value of the variable "g_bDebugMode" in wmscommon.js to have this pop up
'  error dialogs as opposed to quietly suppressing them.  Useful for debugging.

Sub jsCATCH()
%>
/*@if (@_jscript_version >= 1.3)
    }
    catch( e )
    {<% if g_bDebugMode then
            if brMSIE <> g_dwBrowserType then
                if( g_bShowJSErrorDialogs ) then %>
        window.alert( "Err description: " + e.message );<%
                end if
            else %>
        throw( e );<%
            end if
        end if %>
    }
@end @*/
<%
End Sub
%>
<script language="JavaScript" runat=SERVER>
/*@cc_on @*/

///////////////////////////
function SafeUnescape( szInput )
{
    var szRetVal = new String( szInput );

    if( 0 == szRetVal.length )
    {
        return( "" );
    }

/*@if (@_jscript_version >= 5.5)
    szRetVal = decodeURIComponent( szRetVal );
   @else @*/
    szRetVal = unescape( szRetVal );
/*@end @*/
    return( szRetVal );
}

///////////////////////////
function SafeEscape( szInput )
{
    var szRetVal = new String( szInput );
    if( 0 == szRetVal.length )
    {
        return( "" );
    }

    // prevent dbl-escape bugs
    szUnescapedVal = SafeUnescape( szInput );
    if( szUnescapedVal != szInput )
    {
        return( szInput );
    }

/*@if (@_jscript_version >= 5.5)
    szRetVal = encodeURIComponent( szRetVal );
   @else @*/
    szRetVal = escape( szRetVal );
/*@end @*/
    return( szRetVal );
}

///////////////////////////
//
// Take a UTC date and format so that it doesn't get coerced into being local to IIS
//
function FormatDateAsUTC( szInput )
{
/*
    var dateUTC;
    dateUTC = new Date( szInput );
    return( dateUTC.toUTCString() );
*/
    var dateInput;
    var dateUTC;

    var dateNow;
    var tzOffset;
    var dwOffsetInHours;
    var dwOffsetInMinutes;

    dateNow = new Date();
    tzOffset = dateNow.getTimezoneOffset();
    dwOffsetInHours = tzOffset / 60;
    dwOffsetInMinutes = tzOffset - ( dwOffsetInHours * 60 );

    dateInput = new Date( szInput );

    dateUTC = new Date( dateInput );
    dateUTC.setUTCHours( dateInput.getUTCHours() - dwOffsetInHours );
    dateUTC.setUTCMinutes( dateInput.getUTCMinutes() - dwOffsetInMinutes );

    return( dateUTC.toUTCString() );
}
</script>

<%
'///////////////////////////
Sub WriteCommonJSUtils()
    on error resume next

    DisableContextMenu
%>

///////////////////////////
function ShowServerList()
{
    <% jsTRY %>
        window.open( "/wmssecure/index.asp?show=true", "sList", "hotkeys,scrollbars,status,menubar,resizable", true );
    <% jsCATCH %>
}
<%
    if( FALSE = g_bSecureConnection ) then %>

///////////////////////////
function ShowHideSecureWarning( szPathToImg )
{
    <% jsTRY %>
    if( parent.frames && parent.frames[ "treeFrames" ] )
    {
        if( parent.frames && parent.frames[ "treeFrames" ].frames[ "frameTreeCode" ] )
        {
            return;
        }
    }
    document.write( "<td align=left valign=top>" );
    document.write( "<a href=\"" + document.location.protocol + "//" + parent.document.location.host + "/nonsecure.asp" + "\" target=\"sList\" style=\"position:absolute;right:15;top:10\" border=0><img alt=\"<%= Server.HTMLEncode( L_NONSECUREWARNING_TEXT ) %>\" border=\"0\" src=\"" + szPathToImg + "\"></a>" );
    document.write( "</td> " );
    <% jsCATCH %>
}
<%
    end if

    BrowserSniff
    if brMSIE = g_dwBrowserType then
%>

///////////////////////////
function UpdateTreeViewSelection()
{
    <% jsTRY %>
    var childFrame;
    childFrame = window.parent.frames[ "treeFrames" ];
    if( childFrame )
    {
        childFrame = window.parent.frames[ "treeFrames" ].frames[ "frameTreeCode" ];
    }
    if( childFrame )
    {<%
        Dim strTOCEntry

        if( IsEmpty( g_strPubPointID ) or ( 0 < Len( g_strPubPointID ) ) ) then
            strTOCEntry = g_strPubPointID
        else
            if( 0 < InStr( 1, Request.ServerVariables( "PATH_INFO" ), "server_diag", vbTextCompare ) ) then
                strTOCEntry = "diag"
            else
                strTOCEntry = "server"
            end if
        end if
    %>
    /*@if (@_jscript_version >= 1.3)
        try
        {
    @end @*/
            if( childFrame.SetSelectedNode )
            {
                childFrame.SetSelectedNode( "<%= strTOCEntry %>" );
            }
    /*@if (@_jscript_version >= 1.3)
        }
        catch( e )
        {
            return;
        }
    @end @*/
    }
    <% jsCATCH %>
}
<%
    end if
End Sub

''//////////////////////////////
Sub DrawStdFooter()
    if brMSIE = g_dwBrowserType then %>
<script language="JavaScript">
<% jsTRY %>
    UpdateTreeViewSelection();
<% jsCATCH %>
</script>
<script language="JScript" event=onclick for=window>
    return false;
</script>
<!--
<%= Server.HTMLEncode( L_COPYRIGHT_TEXT ) %>
-->
<%
    end if
End Sub
%>